home *** CD-ROM | disk | FTP | other *** search
/ Delphi 2 - Developers' Solutions / Delphi 2 Developers' Solutions.iso / dds / chap09 / howto05 / delphi10 / cciccfrm.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-06-11  |  73.4 KB  |  2,194 lines
  1. unit Cciccfrm;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs, ExtCtrls, StdCtrls, Buttons, Menus, FileCtrl,
  8.   {Winsock,} CCWSock, CCICCInf, CCICCPrf, IniFiles, Gauges;
  9.  
  10. type
  11.   { This record holds the information for a number of internet connections }
  12.   PConnectionsRecord = ^TConnectionsRecord;
  13.   TConnectionsRecord = record
  14.     CProfile   : string; { Connection profile; used in lists }
  15.     CIPAddress : string; { Dotted character IP Address       }
  16.     CUserName  : string; { Login name to site; can be anonym }
  17.     CPassword  : string; { Password; won't be shown          }
  18.     CStartDir  : string; { Starting directory; used for FTP  }
  19.   end;
  20.   { Array of TCR }
  21.   CRFile = file of TConnectionsRecord; { File type for TCRec }
  22.   TCCINetCCForm = class(TForm)
  23.     Panel1: TPanel;
  24.     Panel2: TPanel;
  25.     Panel3: TPanel;
  26.     Panel4: TPanel;
  27.     Panel5: TPanel;
  28.     Panel6: TPanel;
  29.     ListBox1: TListBox;
  30.     Panel7: TPanel;
  31.     SpeedButton1: TSpeedButton;
  32.     SpeedButton2: TSpeedButton;
  33.     ListBox2: TListBox;
  34.     ComboBox1: TComboBox;
  35.     Button1: TButton;
  36.     Memo1: TMemo;
  37.     SpeedButton4: TSpeedButton;
  38.     SpeedButton5: TSpeedButton;
  39.     SpeedButton3: TSpeedButton;
  40.     Panel8: TPanel;
  41.     Label1: TLabel;
  42.     Label2: TLabel;
  43.     ComboBox2: TComboBox;
  44.     Label3: TLabel;
  45.     ComboBox3: TComboBox;
  46.     Label4: TLabel;
  47.     Label5: TLabel;
  48.     OpenDialog1: TOpenDialog;
  49.     SaveDialog1: TSaveDialog;
  50.     PrintDialog1: TPrintDialog;
  51.     PrinterSetupDialog1: TPrinterSetupDialog;
  52.     FindDialog1: TFindDialog;
  53.     ReplaceDialog1: TReplaceDialog;
  54.     Gauge1: TGauge;
  55.     MainMenu1: TMainMenu;
  56.     Network1: TMenuItem;
  57.     ViewWinsockInfo1: TMenuItem;
  58.     Description1: TMenuItem;
  59.     SystemStatus1: TMenuItem;
  60.     VendorSpecific1: TMenuItem;
  61.     N1: TMenuItem;
  62.     ProgressInfo1: TMenuItem;
  63.     ViewInEditWindow1: TMenuItem;
  64.     ViewInStatusLine1: TMenuItem;
  65.     SaveToFile1: TMenuItem;
  66.     N2: TMenuItem;
  67.     Exit1: TMenuItem;
  68.     Services1: TMenuItem;
  69.     IPAddress1: TMenuItem;
  70.     EMail1: TMenuItem;
  71.     FTP1: TMenuItem;
  72.     UsenetNws1: TMenuItem;
  73.     Files1: TMenuItem;
  74.     Load1: TMenuItem;
  75.     Save1: TMenuItem;
  76.     Encoding1: TMenuItem;
  77.     UUDecode1: TMenuItem;
  78.     MIMEDecode1: TMenuItem;
  79.     UUEncode1: TMenuItem;
  80.     MIMEEncode1: TMenuItem;
  81.     Edit1: TMenuItem;
  82.     Cut1: TMenuItem;
  83.     Copy1: TMenuItem;
  84.     CopytoFile1: TMenuItem;
  85.     Paste1: TMenuItem;
  86.     PastefromFile1: TMenuItem;
  87.     EMail2: TMenuItem;
  88.     CheckMail1: TMenuItem;
  89.     CreateNewMessage1: TMenuItem;
  90.     ReplyToCurrentMessage1: TMenuItem;
  91.     SendCurrentMessage1: TMenuItem;
  92.     SendQueue1: TMenuItem;
  93.     MailServers1: TMenuItem;
  94.     Mailboxes1: TMenuItem;
  95.     Correspondents1: TMenuItem;
  96.     TrashMarkedMessages1: TMenuItem;
  97.     EmptyTrash1: TMenuItem;
  98.     ExitEMailRequired1: TMenuItem;
  99.     FTP2: TMenuItem;
  100.     ConnectToSite1: TMenuItem;
  101.     Disconnect1: TMenuItem;
  102.     UploadMarked1: TMenuItem;
  103.     ASCII1: TMenuItem;
  104.     Binary1: TMenuItem;
  105.     DownloadMarked1: TMenuItem;
  106.     ASCII2: TMenuItem;
  107.     ToFile1: TMenuItem;
  108.     ToDisplay1: TMenuItem;
  109.     Binary2: TMenuItem;
  110.     Directory1: TMenuItem;
  111.     ViewRemoteasText1: TMenuItem;
  112.     ViewasText1: TMenuItem;
  113.     Change1: TMenuItem;
  114.     Create1: TMenuItem;
  115.     Delete3: TMenuItem;
  116.     ChangeLocal1: TMenuItem;
  117.     DeleteRemoteFiles1: TMenuItem;
  118.     FTPSites1: TMenuItem;
  119.     News1: TMenuItem;
  120.     ConnectandUpdate1: TMenuItem;
  121.     Disconnect2: TMenuItem;
  122.     Headers1: TMenuItem;
  123.     RetrieveMarked1: TMenuItem;
  124.     RetrieveAll1: TMenuItem;
  125.     CheckNewNews1: TMenuItem;
  126.     GetMarked1: TMenuItem;
  127.     Article1: TMenuItem;
  128.     NewArticle1: TMenuItem;
  129.     FollowupArticle1: TMenuItem;
  130.     PutinQueue1: TMenuItem;
  131.     Post1: TMenuItem;
  132.     CurrentArticle1: TMenuItem;
  133.     EntireQueue1: TMenuItem;
  134.     NewsServers1: TMenuItem;
  135.     SubscribedNewsgroups1: TMenuItem;
  136.     Trash1: TMenuItem;
  137.     AllReadArticles1: TMenuItem;
  138.     AllMarkedArticles1: TMenuItem;
  139.     AllAvailableArticles1: TMenuItem;
  140.     DownloadActiveNewsgroups1: TMenuItem;
  141.     Preferences1: TMenuItem;
  142.     EMail3: TMenuItem;
  143.     FTP3: TMenuItem;
  144.     News2: TMenuItem;
  145.     Paths1: TMenuItem;
  146.     procedure Exit1Click(Sender: TObject);
  147.     procedure FormCreate(Sender: TObject);
  148.     procedure FormDestroy(Sender: TObject);
  149.     procedure Description1Click(Sender: TObject);
  150.     procedure SystemStatus1Click(Sender: TObject);
  151.     procedure VendorSpecific1Click(Sender: TObject);
  152.     procedure ViewInEditWindow1Click(Sender: TObject);
  153.     procedure ViewInStatusLine1Click(Sender: TObject);
  154.     procedure SaveToFile1Click(Sender: TObject);
  155.     procedure IPAddress1Click(Sender: TObject);
  156.     procedure FTP1Click(Sender: TObject);
  157.     procedure FormResize(Sender: TObject);
  158.     procedure FTPSites1Click(Sender: TObject);
  159.     procedure FTP3Click(Sender: TObject);
  160.     procedure ConnectToSite1Click(Sender: TObject);
  161.     procedure Button1Click(Sender: TObject);
  162.     procedure ViewasText1Click(Sender: TObject);
  163.     procedure Disconnect1Click(Sender: TObject);
  164.     procedure Change1Click(Sender: TObject);
  165.     procedure ChangeLocal1Click(Sender: TObject);
  166.     procedure ListBox1DblClick(Sender: TObject);
  167.     procedure ListBox2DblClick(Sender: TObject);
  168.   private
  169.     { Private declarations }
  170.   public
  171.     { Public declarations }
  172.     procedure EnableFTPMenus;
  173.     procedure DisableFTPMenus;
  174.     procedure UpdateGauge( BytesFinished , TotalToHandle : longint );
  175.     function DoFTPConnection( PCRPointer : PConnectionsRecord ) : boolean;
  176.     procedure DoFTPDisconnect;
  177.     procedure ReadIniData;
  178.     procedure WriteIniData;
  179.     procedure LoadFTPSiteFile;
  180.     procedure SaveFTPSiteFile;
  181.     procedure SetupFTPSiteLists;
  182.     procedure AddNullTermTextToMemo( TheTextToAdd   : string;
  183.                                      TheMemoToAddTo : TMemo   );
  184.     function AddNullTermTextToLabel( TheTextToAdd   : string ) : string;
  185.     procedure SetHGCursors;
  186.     procedure SetNormalCursors;
  187.     procedure AddProgressText( WhatText : string );
  188.     procedure ShowProgressText( WhatText : string );
  189.     procedure ShowProgressErrorText( WhatText : string );
  190.     procedure SocketsErrorOccurred( Sender     : TObject;
  191.                                      ErrorCode  : Integer;
  192.                                      TheMessage : string   );
  193.   end;
  194.   { Component to hold FTP handling capabilities }
  195.   TFTPComponent = class( TWinControl )
  196.   public
  197.     FTPCommandInProgress ,
  198.     Connection_Established : Boolean;
  199.     Socket1 : TCCSocket;
  200.     Socket2 : TCCSocket;
  201.     constructor Create( AOwner : TComponent ); override;
  202.     destructor Destroy; override;
  203.     function StripBrackets( TheString : string ) : string;
  204.     function GetShortPathname( TheString : string ) : string;
  205.     function GetWin16FileName( InputName : string ) : string;
  206.     function GetRemoteWorkingDirectory( var RemoteDir : string ) : Boolean;
  207.     function SetRemoteDirectory( TheDir : string ) : Boolean;
  208.     function EstablishConnection( PCRPointer : PConnectionsRecord ) : Boolean;
  209.     function LoginUser( PCRPointer : PConnectionsRecord ) : Boolean;
  210.     function SendPassword( PCRPointer : PConnectionsRecord ) : Boolean;
  211.     function SetRemoteStartupDirectory( PCRPointer : PConnectionsRecord )
  212.               : Boolean;
  213.     function GetRemoteDirectoryListing( TheListBox : TListBox ) : Boolean;
  214.     function GetRemoteDirectoryListingToMemo : Boolean;
  215.     function GetLocalDirectoryAndListing( var TheString : string;
  216.                                               TheListBox : TListBox )
  217.               : Boolean;
  218.     function GetUNIXTextString( var StringIn : string ) : string;
  219.     function GetListeningPort : Integer;
  220.     procedure GetFileNameFromUNIXFileName( var TheName : string );
  221.     function Disconnect : Boolean;
  222.     function DoCStyleFormat(       TheText      : string;
  223.                              const TheArguments : array of const ) : string;
  224.     procedure UpdateGauge( BytesFinished , TotalToHandle : longint );
  225.     function GetQuotedString( TheString : string ) : string;
  226.     procedure AddProgressText( WhatText : string );
  227.     procedure ShowProgressText( WhatText : string );
  228.     procedure ShowProgressErrorText( WhatText : string );
  229.     function GetFTPServerResponse( var ResponseString : string ) : Integer;
  230.     procedure FTPSocketsErrorOccurred( Sender     : TObject;
  231.                                      ErrorCode  : Integer;
  232.                                      TheMessage : string   );
  233.     function PerformFTPCommand(
  234.                     TheCommand   : string;
  235.               const TheArguments : array of const ) : Integer;
  236.   end;
  237. const
  238.   POV_MEMO                 = 1; { Progress to the Memo           }
  239.   POV_STAT                 = 2; { Progress to the status caption }
  240.   FTP_STATUS_PRELIMINARY   = 1; { Wait; command being processed  }
  241.   FTP_STATUS_COMPLETED     = 2; { Done; command fully succeded   }
  242.   FTP_STATUS_CONTINUING    = 3; { OK; send more data to finish   }
  243.   FTP_STATUS_RETRY_COMMAND = 4; { Temporary Error; try cmd again }
  244.   FTP_STATUS_FATAL_ERROR   = 5; { Fatal Error; don't retry cmd   }
  245.  
  246. var
  247.   CCINetCCForm         : TCCINetCCForm;
  248.   GlobalErrorCode      : Integer;        { Used to pass around error info  }
  249.   GlobalAbortedFlag    : Boolean;        { Used to signal timeout error    }
  250.   ProgressList         : TStringList;    { Used to hold progress text info }
  251.   ProgressFileName     : string;         { Used to hold progress file name }
  252.   ProgressOutputVector : Integer;        { Used to direct progress output  }
  253.   TheFTPSiteList       : TList;          { Used to store the FTP site recs }
  254.   TheWorkingFTPSL      : TList;          { Used to store working copy of l }
  255.   TheFTPSiteFile       : CRFile;         { Used to load the FTP site file  }
  256.   TheICCIniFile        : TIniFile;       { Used to retrieve the INI File   }
  257.   MailPath             : string;         { Used for path to Mail Files     }
  258.   NewsPath             : string;         { Used for path to News Files     }
  259.   WWWPath              : string;         { Used for path to WWW Files      }
  260.   FTPPath              : string;         { Used for path to FTP Files      }
  261.   CurrentPassWordString : string;        { Used to hold login id for anons }
  262.   PassWordControlVector : Integer;       { Used to hold display of pw vect }
  263.   CurrentRealPWString   : string;        { Used to hold a real password    }
  264.   TheFTPComponent       : TFTPComponent; { FTP Object                      }
  265.   TheLine ,
  266.   HolderLine ,
  267.   GlobalTextBuffer      : string;
  268.   TheAnonRedialVector ,
  269.   DefaultDownloadVector : Integer;
  270.   LeftoverText          : string;
  271.   LeftoversOnTable      : Boolean;
  272.   FileNameToXFer        : string;
  273.  
  274. implementation
  275.  
  276. {$R *.DFM}
  277.  
  278. { This is the FTP component constructor; it creates 2 sockets }
  279. constructor TFTPComponent.Create( AOwner : TComponent );
  280. begin
  281.   { do inherited create }
  282.   inherited Create( AOwner );
  283.   { Create sockets, put in their parents, and error procs }
  284.   Socket1 := TCCSocket.Create( Self );
  285.   Socket1.Parent := Self;
  286.   Socket1.OnErrorOccurred := FTPSocketsErrorOccurred;
  287.   Socket2 := TCCSocket.Create( Self );
  288.   Socket2.Parent := Self;
  289.   Socket2.OnErrorOccurred := FTPSocketsErrorOccurred;
  290.   { Set up booleans }
  291.   Connection_Established := false;
  292.   FTPCommandInProgress := false;
  293. end;
  294.  
  295. { This is the FTP component destructor; it frees 2 sockets }
  296. destructor TFTPComponent.Destroy;
  297. begin
  298.   { Free the sockets }
  299.   Socket1.Free;
  300.   Socket2.Free;
  301.   { and call inherited }
  302.   inherited Destroy;
  303. end;
  304.  
  305. function TFTPComponent.GetShortPathname( TheString : string ) : string;
  306. var HoldingString : string;
  307. begin
  308.   HoldingString := Copy( TheString , 1 , 3 );
  309.   HoldingString := HoldingString + '..\' + ExtractFileName( TheString );
  310.   Result := HoldingString;
  311. end;
  312.  
  313. function TFTPComponent.StripBrackets( TheString : string ) : string;
  314. var HoldingString : string;
  315.     HoldingPosition : Integer;
  316. begin
  317.   HoldingPosition := Pos( '[' , TheString );
  318.   if HoldingPosition = 0 then
  319.   begin
  320.     Result := TheString;
  321.     exit;
  322.   end
  323.   else
  324.   begin
  325.     HoldingString := Copy( TheString , HoldingPosition + 1 , 255 );
  326.     HoldingPosition := Pos( ']' , HoldingString );
  327.     if HoldingPosition = 0 then
  328.     begin
  329.       Result := HoldingString;
  330.       exit;
  331.     end
  332.     else
  333.     begin
  334.       HoldingString := Copy( HoldingString , 1 , HoldingPosition - 1 );
  335.       Result := HoldingString;
  336.       exit;
  337.     end;
  338.   end;
  339. end;
  340.  
  341. { This function takes a UNIX filespec and turns it into a Win16 filename }
  342. function TFTPComponent.GetWin16FileName( InputName : string ) : string;
  343. var WorkingString ,
  344.     HoldingString   : string; { Holding string }
  345. begin
  346.   WorkingString := ExtractFileExt( InputName );
  347.   if WorkingString = '' then
  348.   begin
  349.     if Length( InputName ) > 8 then
  350.      WorkingString := Copy( InputName , 1 , 8 ) else
  351.       WorkingString := InputName;
  352.   end
  353.   else
  354.   begin
  355.     if Length( WorkingString ) > 4 then
  356.      WorkingString := Copy( WorkingString , 1 , 4 );
  357.     HoldingString :=
  358.      Copy( InputName , 1 , Pos( WorkingString , InputName ) - 1 );
  359.     if Length( HoldingString ) > 8 then
  360.      HoldingString := Copy( HoldingString , 1 , 8 );
  361.     if HoldingString = '' then
  362.     begin
  363.       { Dot file }
  364.       HoldingString := Copy( InputName , 2 , 255 ) + '.TXT';
  365.       WorkingString := HoldingString;
  366.     end
  367.     else WorkingString := HoldingString + WorkingString;
  368.   end;
  369.   Result := WorkingString;
  370. end;
  371.  
  372.  
  373. procedure TFTPComponent.UpdateGauge( BytesFinished , TotalToHandle : longint );
  374. begin
  375.   CCInetCCForm.UpdateGauge( BytesFinished , TotalToHandle );
  376. end;
  377.  
  378. { This sends FTP progress text to the Inet form }
  379. procedure TFTPComponent.AddProgressText( WhatText : string );
  380. begin
  381.   CCInetCCForm.AddProgressText( WhatText );
  382. end;
  383.  
  384. { This sends FTP progress text to the Inet form }
  385. procedure TFTPComponent.ShowProgressText( WhatText : string );
  386. begin
  387.   CCInetCCForm.ShowProgressText( WhatText );
  388. end;
  389.  
  390. { This sends FTP progress text to the Inet form }
  391. procedure TFTPComponent.ShowProgressErrorText( WhatText : string );
  392. begin
  393.   CCInetCCForm.ShowProgressErrorText( WhatText );
  394. end;
  395.  
  396. { This is a core function! It performs an FTP command and if no timeout }
  397. { return a preliminary ok.                                              }
  398. function TFTPComponent.PerformFTPCommand(
  399.                  TheCommand        : string;
  400.            const TheArguments      : array of const ) : Integer;
  401. var TheBuffer : string; { Text buffer }
  402. begin
  403.   { If command in progress send back -1 error }
  404.   if FTPCommandInProgress then
  405.   begin
  406.     Result := -1;
  407.     exit;
  408.   end;
  409.   { Set status variable }
  410.   FTPCommandInProgress := True;
  411.   { Set global error code }
  412.   GlobalErrorCode := 0;
  413.   { Format output string }
  414.   TheBuffer := Format( TheCommand , TheArguments );
  415.   { Preset failure code }
  416.   Result := FTP_STATUS_FATAL_ERROR;
  417.   { If invalid socket or no connection abort }
  418.   if ( Socket1.TheSocket = INVALID_SOCKET ) or not Connection_Established then
  419.    exit;
  420.   { Send the buffer plus EOL chars }
  421.   Socket1.StringData := TheBuffer + #13#10;
  422.   { if abort due to timeout or other error exit }
  423.   if (( GlobalAbortedFlag ) or ( GlobalErrorCode <> 0 )) then exit;
  424.   { Otherwise return preliminary code }
  425.   Result := FTP_STATUS_PRELIMINARY;
  426. end;
  427.  
  428. { This function gets up to 255 chars of data plus a return code from FTP serv }
  429. function TFTPComponent.GetFTPServerResponse(
  430.           var ResponseString : string ) : Integer;
  431. var
  432.   { Buffer string for response line }
  433.   TheBuffer     : string;
  434.   { Pointer to the response string }
  435.   BufferPointer : array[0..255] of char absolute TheBuffer;
  436.   { Character to check for response code }
  437.   ResponseChar   : char;
  438.   { Pointers into returned string }
  439.   TheIndex ,
  440.   TheLength     : Integer;
  441.   { Control variable }
  442.   LeftoversInPan ,
  443.   Finished      : Boolean;
  444. begin
  445.   { Preset fatal error }
  446.   Result := FTP_STATUS_FATAL_ERROR;
  447.   { Start loop control }
  448.   LeftoversInPan := false;
  449.   Finished := false;
  450.   repeat
  451.     { Do a peek }
  452.     TheBuffer := Socket1.PeekData;
  453.     { If timeout or other error exit }
  454.     if (( GlobalAbortedFlag ) or ( GlobalErrorCode <> 0 )) then exit;
  455.     { Find end of line character }
  456.     TheIndex := Pos( #10 , TheBuffer );
  457.     if TheIndex = 0 then
  458.     begin
  459.       TheIndex := Pos( #13 , TheBuffer );
  460.       if TheIndex = 0 then
  461.       begin
  462.         TheIndex := Pos( #0 , TheBuffer );
  463.         if TheIndex = 0 then
  464.         begin
  465.           TheIndex := Length( TheBuffer );
  466.           LeftoversInPan := True;
  467.           LeftoverText := LeftoverText + TheBuffer;
  468.           LeftoversOnTable := false;
  469.         end;
  470.       end;
  471.     end;
  472.     { If an end of line then process the line }
  473.     if TheIndex > 0 then
  474.     begin
  475.       { Get length of string }
  476.       TheLength := TheIndex;
  477.       { Receive actual data }
  478.       Socket1.CCSockReceive( Socket1.TheSocket   ,
  479.                              @BufferPointer[ 1 ] ,
  480.                              TheLength              );
  481.       { Abort if timeout or error }
  482.       if (( GlobalAbortedFlag ) or ( GlobalErrorCode <> 0 )) then exit;
  483.       { Put in the length byte }
  484.       BufferPointer[ 0 ] := Chr( TheLength );
  485.       if LeftOversOnTable then
  486.       begin
  487.         LeftOversOnTable := false;
  488.         ResponseString := LeftoverText + TheBuffer;
  489.         TheBuffer := ResponseString;
  490.         LeftoverText := '';
  491.       end;
  492.       if LeftoversInPan then
  493.       begin
  494.         LeftoversInPan := false;
  495.         LeftoversOnTable := true;
  496.       end;
  497.       { If not a continuation line }
  498.       if TheBuffer[ 4 ] <> '-' then
  499.       begin
  500.         { Get first number character }
  501.         ResponseChar := TheBuffer[ 1 ];
  502.         { Get the value of the number from 1 to 5 }
  503.         if (( ResponseChar >= '1' ) and ( ResponseChar <= '5' )) then
  504.         begin
  505.           Finished := true;
  506.           Result := Ord( ResponseChar ) - 48;
  507.         end;
  508.       end
  509.       else
  510.       begin
  511.         { otherwise return preliminary result }
  512.         Finished := true;
  513.         Result := FTP_STATUS_PRELIMINARY;
  514.       end;
  515.     end
  516.     else
  517.     begin
  518.     end;
  519.   until ( Finished and ( not LeftoversOnTable ));
  520.   { Return buffer as response string }
  521.   ResponseString := TheBuffer;
  522. end;
  523.  
  524. { Boilerplate error routine }
  525. procedure TFTPComponent.FTPSocketsErrorOccurred( Sender     : TObject;
  526.                                                  ErrorCode  : Integer;
  527.                                                  TheMessage : string   );
  528. begin
  529.   CCInetCCForm.SocketsErrorOccurred( Sender,ErrorCode,TheMessage );
  530. end;
  531.  
  532. { This is the FTP components initial connection routine }
  533. function TFTPComponent.EstablishConnection(
  534.           PCRPointer : PConnectionsRecord ) : Boolean;
  535. var TheReturnString : string;  { Internal string holder }
  536.     TheResult       : Integer; { Internal int holder    }
  537. begin
  538.   { Set default FTP Port value }
  539.   Socket1.PortName := '21';
  540.   { Get the ip address from the record }
  541.   Socket1.IPAddressName := PCRPointer^.CIPAddress;
  542.   { Set blocking mode }
  543.   Socket1.AsynchMode := False;
  544.   { Clear condition variables }
  545.   GlobalErrorCode := 0;
  546.   GlobalAbortedFlag := false;
  547.   { Actually attempt to connect }
  548.   Socket1.CCSockConnect;
  549.   { Check if connected }
  550.   if (( GlobalAbortedFlag ) or ( GlobalErrorCode <> 0 ) or
  551.       ( Socket1.TheSocket = INVALID_SOCKET )) then
  552.   begin { Didn't connect; signal error and abort }
  553.     { Do clever C formatting trick }
  554.     TheReturnString :=
  555.      DoCStyleFormat( 'FTP Host %s Connection Failed!' ,
  556.       [ PCRPointer^.CIPAddress ] );
  557.     { Put result in progress and status line }
  558.     AddProgressText( TheReturnString );
  559.     ShowProgressErrorText( TheReturnString );
  560.     { Signal error }
  561.     Result := False;
  562.     { leave }
  563.     exit;
  564.   end
  565.   else
  566.   begin
  567.     Connection_Established := true;
  568.     { Signal successful connection }
  569.     TheReturnString := DoCStyleFormat(
  570.       'Connected on Local port: %s with IP: %s',
  571.       [ Socket1.GetSocketPort( Socket1.TheSocket ),
  572.         Socket1.GetSocketIPAddress( Socket1.TheSocket )]);
  573.     { Put result in progress and status line }
  574.     CCINetCCForm.AddProgressText( TheReturnString );
  575.     CCINetCCForm.ShowProgressText( TheReturnString );
  576.     TheReturnString := DoCStyleFormat(
  577.      'Connected to Remote port: %s with IP: %s',
  578.       [ Socket1.GetSocketPeerPort( Socket1.TheSocket ),
  579.         Socket1.GetSocketPeerIPAddress( Socket1.TheSocket )]);
  580.     { Put result in progress and status line }
  581.     CCINetCCForm.AddProgressText( TheReturnString );
  582.     CCINetCCForm.ShowProgressText( TheReturnString );
  583.     TheReturnString := DoCStyleFormat( 'Successfully connected to %s',
  584.      [ Socket1.IPAddressName ]);
  585.     { Put result in progress and status line }
  586.     CCINetCCForm.AddProgressText( TheReturnString );
  587.     CCINetCCForm.ShowProgressText( TheReturnString );
  588.     repeat
  589.       TheResult := GetFTPServerResponse( TheReturnString );
  590.       { Put result in progress and status line }
  591.       AddProgressText( TheReturnString );
  592.       ShowProgressText( TheReturnString );
  593.     until (( GlobalAbortedFlag ) or ( TheResult <> FTP_STATUS_PRELIMINARY ));
  594.     if ( GlobalAbortedFlag or ( TheResult <> FTP_STATUS_COMPLETED )) then
  595.     begin
  596.       { Do clever C formatting trick }
  597.       TheReturnString :=
  598.        DoCStyleFormat( 'FTP Host %s Connection Failed!' ,
  599.         [ PCRPointer^.CIPAddress ] );
  600.       { Put result in progress and status line }
  601.       AddProgressText( TheReturnString );
  602.       ShowProgressErrorText( TheReturnString );
  603.       { Signal error }
  604.       Result := False;
  605.       { leave }
  606.       exit;
  607.     end
  608.     else Result := true; { Signal no problem }
  609.   end;
  610. end;
  611.  
  612. { This is the FTP components USER login routine }
  613. function TFTPComponent.LoginUser(
  614.           PCRPointer : PConnectionsRecord ) : Boolean;
  615. var TheReturnString : string;  { Internal string holder }
  616.     TheResult       : Integer; { Internal int holder    }
  617. begin
  618.   TheReturnString :=
  619.    DoCStyleFormat( 'USER %s' ,
  620.     [ PCRPointer^.CUserName ] );
  621.   { Put result in progress and status line }
  622.   AddProgressText( TheReturnString );
  623.   ShowProgressText( TheReturnString );
  624.   { Begin login sequence with user name }
  625.   TheResult := PerformFTPCommand( 'USER %s',
  626.                                   [ PCRPointer^.CUserName ] );
  627.   if TheResult <> FTP_STATUS_PRELIMINARY then
  628.   begin
  629.     FTPCommandInProgress := false;
  630.     Result := false;
  631.     exit;
  632.   end;
  633.   repeat
  634.     TheResult := GetFTPServerResponse( TheReturnString );
  635.     { Put result in progress and status line }
  636.     AddProgressText( TheReturnString );
  637.     ShowProgressText( TheReturnString );
  638.   until (( GlobalAbortedFlag ) or ( TheResult <> FTP_STATUS_PRELIMINARY ));
  639.   FTPCommandInProgress := false;
  640.   if ( GlobalAbortedFlag or ( TheResult <> FTP_STATUS_CONTINUING )) then
  641.   begin
  642.     { Do clever C formatting trick }
  643.     TheReturnString :=
  644.      DoCStyleFormat( 'FTP Host %s Connection Failed!' ,
  645.       [ PCRPointer^.CIPAddress ] );
  646.     { Put result in progress and status line }
  647.     AddProgressText( TheReturnString );
  648.     ShowProgressErrorText( TheReturnString );
  649.     { Signal error }
  650.     Result := False;
  651.     { leave }
  652.     exit;
  653.   end
  654.   else Result := true; { Signal no problem }
  655. end;
  656.  
  657.  
  658. { This is the FTP components PASSWORD routine }
  659. function TFTPComponent.SendPassword(
  660.           PCRPointer : PConnectionsRecord ) : Boolean;
  661. var TheReturnString : string;  { Internal string holder }
  662.     TheResult       : Integer; { Internal int holder    }
  663. begin
  664.   TheReturnString := 'PASS XXXXXX' + #13#10;
  665.   { Put result in progress and status line }
  666.   AddProgressText( TheReturnString );
  667.   ShowProgressText( TheReturnString );
  668.   { Send Password sequence }
  669.   TheResult := PerformFTPCommand( 'PASS %s',
  670.                                   [ PCRPointer^.CPassword ] );
  671.   if TheResult <> FTP_STATUS_PRELIMINARY then
  672.   begin
  673.     Result := false;
  674.     FTPCommandInProgress := false;
  675.     exit;
  676.   end;
  677.   repeat
  678.     TheResult := GetFTPServerResponse( TheReturnString );
  679.     { Put result in progress and status line }
  680.     AddProgressText( TheReturnString );
  681.     ShowProgressText( TheReturnString );
  682.   until (( GlobalAbortedFlag ) or ( TheResult <> FTP_STATUS_PRELIMINARY ));
  683.   FTPCommandInProgress := false;
  684.   if ( GlobalAbortedFlag or ( TheResult <> FTP_STATUS_COMPLETED )) then
  685.   begin
  686.     { Do clever C formatting trick }
  687.     TheReturnString :=
  688.      DoCStyleFormat( 'FTP Host %s Connection Failed!' ,
  689.       [ PCRPointer^.CIPAddress ] );
  690.     { Put result in progress and status line }
  691.     AddProgressText( TheReturnString );
  692.     ShowProgressErrorText( TheReturnString );
  693.     { Signal error }
  694.     Result := False;
  695.     { leave }
  696.     exit;
  697.   end
  698.   else Result := true; { Signal no problem }
  699. end;
  700.  
  701. { This is the FTP components CWD routine }
  702. function TFTPComponent.SetRemoteStartupDirectory(
  703.           PCRPointer : PConnectionsRecord ) : Boolean;
  704. var TheReturnString : string;  { Internal string holder }
  705.     TheResult       : Integer; { Internal int holder    }
  706. begin
  707.   Result := true;
  708.   if PCRPointer^.CStartDir <> '' then
  709.   begin
  710.     TheReturnString :=
  711.      DoCStyleFormat( 'CWD %s' ,
  712.       [ PCRPointer^.CStartDir ] );
  713.     { Put result in progress and status line }
  714.     AddProgressText( TheReturnString );
  715.     ShowProgressText( TheReturnString );
  716.     { Send Password sequence }
  717.     TheResult := PerformFTPCommand( 'CWD %s',
  718.                                     [ PCRPointer^.CStartDir ] );
  719.     if TheResult <> FTP_STATUS_PRELIMINARY then
  720.     begin
  721.       Result := false;
  722.       FTPCommandInProgress := false;
  723.       exit;
  724.     end;
  725.     repeat
  726.       TheResult := GetFTPServerResponse( TheReturnString );
  727.       { Put result in progress and status line }
  728.       AddProgressText( TheReturnString );
  729.       ShowProgressText( TheReturnString );
  730.    until (( GlobalAbortedFlag ) or ( TheResult <> FTP_STATUS_PRELIMINARY ));
  731.    FTPCommandInProgress := false;
  732.    if ( GlobalAbortedFlag or ( TheResult <> FTP_STATUS_COMPLETED )) then
  733.     begin
  734.       { Do clever C formatting trick }
  735.       TheReturnString :=
  736.        DoCStyleFormat( 'CWD to %s Failed!' ,
  737.         [ PCRPointer^.CStartDir ] );
  738.       { Put result in progress and status line }
  739.       AddProgressText( TheReturnString );
  740.       ShowProgressErrorText( TheReturnString );
  741.       { Signal error }
  742.       Result := False;
  743.       { leave }
  744.       exit;
  745.     end
  746.     else Result := true; { Signal no problem }
  747.   end;
  748. end;
  749.  
  750. { This is the FTP components CWD routine }
  751. function TFTPComponent.SetRemoteDirectory( TheDir : string ) : Boolean;
  752. var TheReturnString : string;  { Internal string holder }
  753.     TheResult       : Integer; { Internal int holder    }
  754. begin
  755.   Result := true;
  756.   if TheDir <> '' then
  757.   begin
  758.     TheReturnString :=
  759.      DoCStyleFormat( 'CWD %s' ,
  760.       [ TheDir ] );
  761.     { Put result in progress and status line }
  762.     AddProgressText( TheReturnString );
  763.     ShowProgressText( TheReturnString );
  764.     { Send Password sequence }
  765.     TheResult := PerformFTPCommand( 'CWD %s',
  766.                                     [ TheDir ] );
  767.     if TheResult <> FTP_STATUS_PRELIMINARY then
  768.     begin
  769.       Result := false;
  770.       FTPCommandInProgress := false;
  771.       exit;
  772.     end;
  773.     repeat
  774.       TheResult := GetFTPServerResponse( TheReturnString );
  775.       { Put result in progress and status line }
  776.       AddProgressText( TheReturnString );
  777.       ShowProgressText( TheReturnString );
  778.    until (( GlobalAbortedFlag ) or ( TheResult <> FTP_STATUS_PRELIMINARY ));
  779.    FTPCommandInProgress := false;
  780.    if ( GlobalAbortedFlag or ( TheResult <> FTP_STATUS_COMPLETED )) then
  781.     begin
  782.       { Do clever C formatting trick }
  783.       TheReturnString :=
  784.        DoCStyleFormat( 'CWD to %s Failed!' ,
  785.         [ TheDir ] );
  786.       { Put result in progress and status line }
  787.       AddProgressText( TheReturnString );
  788.       ShowProgressErrorText( TheReturnString );
  789.       { Signal error }
  790.       Result := False;
  791.       { leave }
  792.       exit;
  793.     end
  794.     else Result := true; { Signal no problem }
  795.   end;
  796. end;
  797.  
  798. { This is the FTP components QUIT routine }
  799. function TFTPComponent.Disconnect : Boolean;
  800. var TheReturnString : string;  { Internal string holder }
  801.     TheResult       : Integer; { Internal int holder    }
  802. begin
  803.   TheReturnString :=
  804.    DoCStyleFormat( 'QUIT' ,
  805.     [ nil ] );
  806.   { Put result in progress and status line }
  807.   AddProgressText( TheReturnString );
  808.   ShowProgressText( TheReturnString );
  809.   { Begin login sequence with user name }
  810.   TheResult := PerformFTPCommand( 'QUIT',
  811.                                   [ nil ] );
  812.   repeat
  813.     TheResult := GetFTPServerResponse( TheReturnString );
  814.     { Put result in progress and status line }
  815.     AddProgressText( TheReturnString );
  816.     ShowProgressText( TheReturnString );
  817.   until (( GlobalAbortedFlag ) or ( TheResult <> FTP_STATUS_PRELIMINARY ));
  818.   FTPCommandInProgress := false;
  819.   if ( GlobalAbortedFlag or ( TheResult <> FTP_STATUS_COMPLETED )) then
  820.   begin
  821.     { Do clever C formatting trick }
  822.     TheReturnString :=
  823.      DoCStyleFormat( 'FTP Host Connection Failed!' ,
  824.       [ nil ] );
  825.     { Put result in progress and status line }
  826.     AddProgressText( TheReturnString );
  827.     ShowProgressErrorText( TheReturnString );
  828.     { Signal error }
  829.     Result := False;
  830.     { leave }
  831.     exit;
  832.   end
  833.   else Result := true; { Signal no problem }
  834. end;
  835.  
  836. { This is the FTP components PWD routine }
  837. function TFTPComponent.GetRemoteWorkingDirectory( var RemoteDir : string )
  838.           : Boolean;
  839. var TheReturnString : string;  { Internal string holder }
  840.     TheResult       : Integer; { Internal int holder    }
  841. begin
  842.   Result := true;
  843.   TheReturnString :=
  844.    DoCStyleFormat( 'PWD' ,
  845.     [ nil ] );
  846.   { Put result in progress and status line }
  847.   AddProgressText( TheReturnString );
  848.   ShowProgressText( TheReturnString );
  849.   { Send Password sequence }
  850.   TheResult := PerformFTPCommand( 'PWD',
  851.                                   [ nil ] );
  852.   if TheResult <> FTP_STATUS_PRELIMINARY then
  853.   begin
  854.     Result := false;
  855.     FTPCommandInProgress := false;
  856.     exit;
  857.   end;
  858.   repeat
  859.     TheResult := GetFTPServerResponse( TheReturnString );
  860.     { Put result in progress and status line }
  861.     AddProgressText( TheReturnString );
  862.     ShowProgressText( TheReturnString );
  863.   until (( GlobalAbortedFlag ) or ( TheResult <> FTP_STATUS_PRELIMINARY ));
  864.   FTPCommandInProgress := false;
  865.   if ( GlobalAbortedFlag or ( TheResult <> FTP_STATUS_COMPLETED )) then
  866.   begin
  867.     { Do clever C formatting trick }
  868.     TheReturnString :=
  869.      DoCStyleFormat( 'FTP Host Connection Failed!' ,
  870.       [ nil ] );
  871.     { Put result in progress and status line }
  872.     AddProgressText( TheReturnString );
  873.     ShowProgressErrorText( TheReturnString );
  874.     { Signal error }
  875.     Result := False;
  876.     { leave }
  877.     exit;
  878.   end
  879.   else
  880.   begin
  881.     Result := true; { Signal no problem }
  882.     RemoteDir := TheReturnString; { Send back last string on faith }
  883.   end;
  884. end;
  885.  
  886. { This function sets up a listening port on socekt 2 and handle text replies }
  887. function TFTPComponent.GetListeningPort : Integer;
  888. var
  889.   Address1 ,
  890.   Address2 ,
  891.   Address3 ,
  892.   Address4        : Integer; { Address Integer conversions }
  893.   IPAddress       : string;  { IP Address holder           }
  894.   PortCommand     : string;  { Command holder              }
  895.   TheResult       : Integer; { Result holder               }
  896.   TheReturnString : string;  { ditto                       }
  897. begin
  898.   { Set up any port on socket 2 }
  899.   Socket2.PortName := '0';
  900.   { Listen on a socket }
  901.   Socket2.CCSockListen;
  902.   { Get the IP Address of socket 1 and convert it to numbers }
  903.   IPAddress := Socket1.GetSocketIPAddress( Socket1.TheSocket );
  904.   Address1 := StrToInt( copy( IPAddress , 1 , Pos( '.' , IPAddress ) -1 ));
  905.   IPAddress := copy( IPAddress , Pos( '.' , IPAddress ) + 1 , 255 );
  906.   Address2 := StrToInt( copy( IPAddress , 1 , Pos( '.' , IPAddress) -1 ));
  907.   IPAddress := copy( IPAddress , Pos( '.' , IPAddress ) + 1 , 255 );
  908.   Address3 := StrToInt( copy( IPAddress , 1 , Pos( '.' , IPAddress ) -1 ));
  909.   Address4 := StrToInt( copy( IPAddress , Pos( '.' , IPAddress ) + 1 , 255 ));
  910.   { Turn it into a command and add socket 2 stuff }
  911.   PortCommand := format( 'PORT %d,%d,%d,%d,%d,%d' ,
  912.    [ Address1 , Address2 , Address3 , Address4 ,
  913.     StrToInt( Socket2.GetSocketPort( Socket2.TheMasterSocket )) Shr 8,
  914.     StrToInt( Socket2.GetSocketPort( Socket2.TheMasterSocket )) and $ff ]);
  915.   { Put result in progress and status line }
  916.   AddProgressText( PortCommand + #13#10 );
  917.   ShowProgressText( PortCommand  + #13#10 );
  918.   TheResult := PerformFTPCommand( PortCommand , [nil] );
  919.   if TheResult <> FTP_STATUS_PRELIMINARY then
  920.   begin
  921.     Result := FTP_STATUS_FATAL_ERROR;
  922.     FTPCommandInProgress := false;
  923.     exit;
  924.   end;
  925.   repeat
  926.     TheResult := GetFTPServerResponse( TheReturnString );
  927.     { Put result in progress and status line }
  928.     AddProgressText( TheReturnString );
  929.     ShowProgressText( TheReturnString );
  930.   until (( GlobalAbortedFlag ) or ( TheResult <> FTP_STATUS_PRELIMINARY ));
  931.   FTPCommandInProgress := false;
  932.   if ( GlobalAbortedFlag or ( TheResult <> FTP_STATUS_COMPLETED )) then
  933.   begin
  934.     { Do clever C formatting trick }
  935.     TheReturnString :=
  936.      DoCStyleFormat( 'FTP Host Connection Failed!' ,
  937.       [ nil ] );
  938.     { Put result in progress and status line }
  939.     AddProgressText( TheReturnString );
  940.     ShowProgressErrorText( TheReturnString );
  941.     { Signal error }
  942.     Result := TheResult;
  943.     { leave }
  944.     exit;
  945.   end
  946.   else
  947.   begin
  948.     { Return good result and leave }
  949.     Result := TheResult;
  950.     exit;
  951.   end;
  952. end;
  953.  
  954. { This function returns part of a unit text string }
  955. function TFTPComponent.GetUNIXTextString( var StringIn : string ) : string;
  956. var
  957.   ReturnString : string;
  958.   TheLength ,
  959.   Counter_1   : Integer;
  960. begin
  961.   TheLength := Length( StringIn );
  962.   if TheLength > 1 then
  963.   begin
  964.     for Counter_1 := 1 to TheLength do
  965.     begin
  966.       if StringIn[ Counter_1 ] = #10 then
  967.       begin
  968.         ReturnString := HolderLine;
  969.         HolderLine := '';
  970.         StringIn := Copy( StringIn , Counter_1 + 1 , 255 );
  971.         Result := ReturnString;
  972.         exit;
  973.       end
  974.       else
  975.       begin
  976.         if StringIn[ Counter_1 ] <> #0 then
  977.         begin
  978.           if StringIn[ Counter_1 ] <> #13 then
  979.            HolderLine := HolderLine + StringIn[ Counter_1 ];
  980.         end
  981.         else
  982.         begin
  983.           Result := '';
  984.           StringIn := '';
  985.         end;
  986.       end;
  987.     end;
  988.   end;
  989.   Result := '';
  990.   StringIn := '';
  991. end;
  992.  
  993. procedure TFTPComponent.GetFileNameFromUNIXFileName( var TheName : string );
  994. var Counter_1 : Integer;
  995.     ResultString : string;
  996.     Finished : Boolean;
  997. begin
  998.   if Pos( 'TOTAL' , Uppercase( TheName )) <> 0 then
  999.   begin
  1000.     TheName := '';
  1001.     exit;
  1002.   end;
  1003.   Counter_1 := Length( TheName );
  1004.   ResultString := '';
  1005.   Finished := false;
  1006.   while not Finished do
  1007.   begin
  1008.     if TheName[ Counter_1 ] <> ' ' then
  1009.     begin
  1010.       Counter_1 := Counter_1 - 1;
  1011.       if Counter_1 = 0 then
  1012.       begin
  1013.         ResultString := TheName;
  1014.         Finished := true;
  1015.       end;
  1016.     end
  1017.     else
  1018.     begin
  1019.       Finished := true;
  1020.       ResultString := Copy( TheName , Counter_1 + 1 , 255 );
  1021.     end;
  1022.   end;
  1023.   TheName := ResultString;
  1024. end;
  1025.  
  1026. { This is the FTP components get remote directory listing into a list box }
  1027. function TFTPComponent.GetRemoteDirectoryListing( TheListBox : TListBox )
  1028.           : Boolean;
  1029. var TheReturnString : string;  { Internal string holder }
  1030.     TheResult       : Integer; { Internal int holder    }
  1031.     InputString     : string;
  1032.     Through ,
  1033.     Finished        : Boolean;
  1034. begin
  1035.   TheListBox.Clear;
  1036.   TheListBox.Items.Add('..');
  1037.   Result := true;
  1038.   TheReturnString :=
  1039.    DoCStyleFormat( 'TYPE A' ,
  1040.     [ nil ] );
  1041.   { Put result in progress and status line }
  1042.   AddProgressText( TheReturnString );
  1043.   ShowProgressText( TheReturnString );
  1044.   { Send Password sequence }
  1045.   TheResult := PerformFTPCommand( 'TYPE A',
  1046.                                   [ nil ] );
  1047.   if TheResult <> FTP_STATUS_PRELIMINARY then
  1048.   begin
  1049.     Result := true;
  1050.     FTPCommandInProgress := false;
  1051.     exit;
  1052.   end;
  1053.   repeat
  1054.     TheResult := GetFTPServerResponse( TheReturnString );
  1055.     { Put result in progress and status line }
  1056.     AddProgressText( TheReturnString );
  1057.     ShowProgressText( TheReturnString );
  1058.   until (( GlobalAbortedFlag ) or ( TheResult <> FTP_STATUS_PRELIMINARY ));
  1059.   FTPCommandInProgress := false;
  1060.   if ( GlobalAbortedFlag or ( TheResult <> FTP_STATUS_COMPLETED )) then
  1061.   begin
  1062.     { Do clever C formatting trick }
  1063.     TheReturnString :=
  1064.      DoCStyleFormat( 'FTP Host Connection Failed!' ,
  1065.       [ nil ] );
  1066.     { Put result in progress and status line }
  1067.     AddProgressText( TheReturnString );
  1068.     ShowProgressErrorText( TheReturnString );
  1069.     { Signal error }
  1070.     Result := true;
  1071.     { leave }
  1072.     exit;
  1073.   end
  1074.   else
  1075.   begin
  1076.     { Set up socket 2 for listening }
  1077.     Socket2.AsynchMode := False;
  1078.     Socket2.NonAsynchTimeoutValue := 60;
  1079.     { do a listen and send command to server that this is receipt socket }
  1080.     if GetListeningPort = FTP_STATUS_FATAL_ERROR then
  1081.     begin
  1082.       Socket2.CCSockCancelListen;
  1083.       exit;
  1084.     end;
  1085.     Socket1.NonAsynchTimeoutValue := 0; {infinite timeout}
  1086.     TheResult := PerformFTPCommand( 'LIST' , [nil] );
  1087.     GetFTPServerResponse( TheReturnString );
  1088.     AddProgressText( TheReturnString );
  1089.     ShowProgressText( TheReturnString );
  1090.     Socket1.NonAsynchTimeoutValue := 30;
  1091.     if (( TheResult = FTP_STATUS_RETRY_COMMAND ) or
  1092.        ( TheResult = FTP_STATUS_FATAL_ERROR )) then
  1093.     begin
  1094.       TheReturnString :=
  1095.        DoCStyleFormat( 'Could not obtain remote directory!' ,
  1096.         [ nil ] );
  1097.       { Put result in progress and status line }
  1098.       AddProgressText( TheReturnString );
  1099.       ShowProgressErrorText( TheReturnString );
  1100.       Socket2.CCSockCancelListen;
  1101.       Result := true;
  1102.       exit;
  1103.     end;
  1104.     Socket2.CCSockAccept;
  1105.     if (( GlobalAbortedFlag ) or ( GlobalErrorCode <> 0 )) then
  1106.     begin
  1107.       TheReturnString :=
  1108.        DoCStyleFormat( 'Could not establish receive socket!' ,
  1109.         [ nil ] );
  1110.       { Put result in progress and status line }
  1111.       AddProgressText( TheReturnString );
  1112.       ShowProgressErrorText( TheReturnString );
  1113.       Result := true;
  1114.       exit;
  1115.     end;
  1116.     Through := false;
  1117.     repeat
  1118.       TheReturnString := Socket2.StringData;
  1119.       if Length( TheReturnString ) = 0 then Through := true;
  1120.       if Length( TheReturnString ) > 0 then
  1121.       begin
  1122.         finished := false;
  1123.         while not finished do
  1124.         begin
  1125.           InputString := GetUNIXTextString( TheReturnString );
  1126.           if InputString = '' then Finished := true else
  1127.           begin
  1128.             GetFileNameFromUNIXFileName( InputString);
  1129.             If InputString <> '' then
  1130.             TheListBox.Items.Add( InputString );
  1131.           end;
  1132.         end;
  1133.       end;
  1134.       if GlobalAbortedFlag then
  1135.       begin
  1136.         Socket1.OutOfBand := 'ABOR'+#13#10;
  1137.         repeat
  1138.           TheResult := GetFTPServerResponse( TheReturnString );
  1139.           { Put result in progress and status line }
  1140.           AddProgressText( TheReturnString );
  1141.           ShowProgressText( TheReturnString );
  1142.         until (( GlobalAbortedFlag ) or ( TheResult <> FTP_STATUS_PRELIMINARY ));
  1143.         result := true;
  1144.         exit;
  1145.       end;
  1146.     until Through;
  1147.     GetFTPServerResponse( TheReturnString );
  1148.     AddProgressText( TheReturnString );
  1149.     ShowProgressText( TheReturnString );
  1150.     { cancel listening on second socket and close it }
  1151.     Socket2.CCSockCancelListen;
  1152.     Socket2.CCSockClose;
  1153.   end;
  1154.   FTPCommandInProgress := false;
  1155. end;
  1156.  
  1157. { This is the FTP components get remote directory listing into a list box }
  1158. function TFTPComponent.GetRemoteDirectoryListingToMemo : Boolean;
  1159. var TheReturnString : string;  { Internal string holder }
  1160.     TheResult       : Integer; { Internal int holder    }
  1161.     InputString     : string;
  1162.     Through ,
  1163.     Finished        : Boolean;
  1164. begin
  1165.   Result := true;
  1166.   TheReturnString :=
  1167.    DoCStyleFormat( 'TYPE A' ,
  1168.     [ nil ] );
  1169.   { Put result in progress and status line }
  1170.   AddProgressText( TheReturnString );
  1171.   ShowProgressText( TheReturnString );
  1172.   { Send Password sequence }
  1173.   TheResult := PerformFTPCommand( 'TYPE A',
  1174.                                   [ nil ] );
  1175.   if TheResult <> FTP_STATUS_PRELIMINARY then
  1176.   begin
  1177.     Result := true;
  1178.     FTPCommandInProgress := false;
  1179.     exit;
  1180.   end;
  1181.   repeat
  1182.     TheResult := GetFTPServerResponse( TheReturnString );
  1183.     { Put result in progress and status line }
  1184.     AddProgressText( TheReturnString );
  1185.     ShowProgressText( TheReturnString );
  1186.   until (( GlobalAbortedFlag ) or ( TheResult <> FTP_STATUS_PRELIMINARY ));
  1187.   FTPCommandInProgress := false;
  1188.   if ( GlobalAbortedFlag or ( TheResult <> FTP_STATUS_COMPLETED )) then
  1189.   begin
  1190.     { Do clever C formatting trick }
  1191.     TheReturnString :=
  1192.      DoCStyleFormat( 'FTP Host Connection Failed!' ,
  1193.       [ nil ] );
  1194.     { Put result in progress and status line }
  1195.     AddProgressText( TheReturnString );
  1196.     ShowProgressErrorText( TheReturnString );
  1197.     { Signal error }
  1198.     Result := true;
  1199.     { leave }
  1200.     exit;
  1201.   end
  1202.   else
  1203.   begin
  1204.     { Set up socket 2 for listening }
  1205.     Socket2.AsynchMode := False;
  1206.     Socket2.NonAsynchTimeoutValue := 30;
  1207.     { do a listen and send command to server that this is receipt socket }
  1208.     if GetListeningPort = FTP_STATUS_FATAL_ERROR then
  1209.     begin
  1210.       Socket2.CCSockCancelListen;
  1211.       exit;
  1212.     end;
  1213.     Socket1.NonAsynchTimeoutValue := 0; {infinite timeout}
  1214.     TheResult := PerformFTPCommand( 'LIST' , [nil] );
  1215.     GetFTPServerResponse( TheReturnString );
  1216.     AddProgressText( TheReturnString );
  1217.     ShowProgressText( TheReturnString );
  1218.     Socket1.NonAsynchTimeoutValue := 30;
  1219.     if (( TheResult = FTP_STATUS_RETRY_COMMAND ) or
  1220.        ( TheResult = FTP_STATUS_FATAL_ERROR )) then
  1221.     begin
  1222.       TheReturnString :=
  1223.        DoCStyleFormat( 'Could not obtain remote directory!' ,
  1224.         [ nil ] );
  1225.       { Put result in progress and status line }
  1226.       AddProgressText( TheReturnString );
  1227.       ShowProgressErrorText( TheReturnString );
  1228.       Socket2.CCSockCancelListen;
  1229.       Result := true;
  1230.       exit;
  1231.     end;
  1232.     Socket2.CCSockAccept;
  1233.     if (( GlobalAbortedFlag ) or ( GlobalErrorCode <> 0 )) then
  1234.     begin
  1235.       TheReturnString :=
  1236.        DoCStyleFormat( 'Could not establish receive socket!' ,
  1237.         [ nil ] );
  1238.       { Put result in progress and status line }
  1239.       AddProgressText( TheReturnString );
  1240.       ShowProgressErrorText( TheReturnString );
  1241.       Result := true;
  1242.       exit;
  1243.     end;
  1244.     Through := false;
  1245.     repeat
  1246.       TheReturnString := Socket2.StringData;
  1247.       if Length( TheReturnString ) = 0 then Through := true;
  1248.       if Length( TheReturnString ) > 0 then
  1249.       begin
  1250.         { Put result in progress and status line }
  1251.         AddProgressText( TheReturnString );
  1252.         ShowProgressText( TheReturnString );
  1253.       end;
  1254.       if GlobalAbortedFlag then
  1255.       begin
  1256.         Socket1.OutOfBand := 'ABOR'+#13#10;
  1257.         repeat
  1258.           TheResult := GetFTPServerResponse( TheReturnString );
  1259.           { Put result in progress and status line }
  1260.           AddProgressText( TheReturnString );
  1261.           ShowProgressText( TheReturnString );
  1262.         until (( GlobalAbortedFlag ) or ( TheResult <> FTP_STATUS_PRELIMINARY ));
  1263.         result := true;
  1264.         exit;
  1265.       end;
  1266.     until Through;
  1267.     GetFTPServerResponse( TheReturnString );
  1268.     AddProgressText( TheReturnString );
  1269.     ShowProgressText( TheReturnString );
  1270.     { cancel listening on second socket and close it }
  1271.     Socket2.CCSockCancelListen;
  1272.     Socket2.CCSockClose;
  1273.   end;
  1274. end;
  1275.  
  1276. { This is the FTP components get local directory listing into a list box }
  1277. function TFTPComponent.GetLocalDirectoryAndListing( var TheString : string;
  1278.                                                         TheListBox : TListBox )
  1279.           : Boolean;
  1280. var TheFLB : TFileListBox;
  1281. begin
  1282.   { Get the working directory }
  1283.   GetDir( 0 , TheString );
  1284.   { Clear incoming LB }
  1285.   TheListBox.Clear;
  1286.   TheFLB := TFileListBox.Create( Application.MainForm );
  1287.   TheFLB.Visible := false;
  1288.   TheFLB.Parent := Application.MainForm;
  1289.   TheFLB.FileType := [ ftNormal , ftDirectory ];
  1290.   TheFLB.Directory := TheString;
  1291.   TheFLB.Update;
  1292.   TheListBox.Items.Assign( TheFLB.Items );
  1293.   TheFLB.Free;
  1294.   result := true;
  1295. end;
  1296.  
  1297. { This is a clever c-style formatting trick }
  1298. function TFTPComponent.DoCStyleFormat(
  1299.                 TheText      : string;
  1300.           const TheArguments : array of const ) : string;
  1301. begin
  1302.   Result := Format( TheText , TheArguments ) + #13#10;
  1303. end;
  1304.  
  1305. function TFTPComponent.GetQuotedString( TheString : string ) : string;
  1306. var TheIndex     : Integer; { Holder var }
  1307.     ResultString : string;  { ditto      }
  1308. begin
  1309.   { Find out if " present at all }
  1310.   TheIndex := Pos( '"' , TheString );
  1311.   If TheIndex = 0 then
  1312.   begin
  1313.     { If not, return null string and exit }
  1314.     Result := '';
  1315.     exit;
  1316.   end
  1317.   else
  1318.   begin
  1319.     { Get from first " to end of string in holder }
  1320.     ResultString := Copy( TheString , TheIndex + 1 , 255 );
  1321.     { Find position to second " }
  1322.     TheIndex := Pos( '"' , ResultString );
  1323.     { If no ending " then return whole string and leave }
  1324.     if TheIndex = 0 then
  1325.     begin
  1326.       Result := ResultString;
  1327.       exit;
  1328.     end
  1329.     else
  1330.     begin
  1331.       { Get internal text between quotes and exit }
  1332.       ResultString := Copy( ResultString , 1 , TheIndex - 1 );
  1333.       Result := ResultString;
  1334.     end;
  1335.   end;
  1336. end;
  1337.  
  1338. procedure TCCINetCCForm.UpdateGauge( BytesFinished , TotalToHandle : longint );
  1339. var
  1340.   Percentage : longint;
  1341. begin
  1342.   if BytesFinished > TotalToHandle then BytesFinished := TotalToHandle;
  1343.   if TotalToHandle = 0 then exit;
  1344.   Percentage := Trunc( 100.0 / ( TotalToHandle / BytesFinished ));
  1345.   Gauge1.Progress := Percentage;
  1346.   Panel1.Caption := '  Status: Transfered ' + IntToStr( BytesFinished ) +
  1347.    ' bytes of file ' + FileNameToXFer + ' (' + IntToStr( Percentage ) + '% Complete)';
  1348. end;
  1349.  
  1350. { This procedure actually attempts to connect to the internet at an ftp site }
  1351. function TCCINetCCForm.DoFTPConnection( PCRPointer : PConnectionsRecord ) : boolean;
  1352. var TheReturnString : string; { Display results of connection in status lines }
  1353.     TheResult       : Integer;{ Result from FTP server                        }
  1354.     FTPLoggedIn     : Boolean;{ Boolean to signal successful login            }
  1355. begin
  1356.   { Create the component }
  1357.   Result := false;
  1358.   { Do busy cursors }
  1359.   SetHGCursors;
  1360.   if not TheFTPComponent.EstablishConnection( PCRPointer ) then
  1361.   begin
  1362.     { Do saved cursors }
  1363.     TheFTPComponent.FTPCommandInProgress := false;
  1364.     TheFTPComponent.Connection_Established := false;
  1365.     SetNormalCursors;
  1366.     exit;
  1367.   end
  1368.   else
  1369.   begin { Connected; continue login process }
  1370.     if not TheFTPComponent.LoginUser( PCRPointer ) then
  1371.     begin
  1372.       { Do saved cursors }
  1373.       TheFTPComponent.FTPCommandInProgress := false;
  1374.       TheFTPComponent.Connection_Established := false;
  1375.       SetNormalCursors;
  1376.       exit;
  1377.     end;
  1378.     if not TheFTPComponent.SendPassword( PCRPointer ) then
  1379.     begin
  1380.       { Do saved cursors }
  1381.       TheFTPComponent.FTPCommandInProgress := false;
  1382.       TheFTPComponent.Connection_Established := false;
  1383.       SetNormalCursors;
  1384.       exit;
  1385.     end;
  1386.     if not TheFTPComponent.SetRemoteStartupDirectory( PCRPointer ) then
  1387.     begin
  1388.       { Do saved cursors }
  1389.       SetNormalCursors;
  1390.       TheFTPComponent.Connection_Established := false;
  1391.       TheFTPComponent.FTPCommandInProgress := false;
  1392.       exit;
  1393.     end;
  1394.     if not TheFTPComponent.GetRemoteWorkingDirectory( TheReturnString ) then
  1395.     begin
  1396.       { Do saved cursors }
  1397.       TheFTPComponent.Connection_Established := false;
  1398.       TheFTPComponent.FTPCommandInProgress := false;
  1399.       SetNormalCursors;
  1400.       exit;
  1401.     end;
  1402.     { Put up remote directory via PWD and strip quotes }
  1403.     Label4.Caption := TheFTPComponent.GetQuotedString( TheReturnString );
  1404.     { Get the listings of directories and exit OK }
  1405.     TheFTPComponent.GetRemoteDirectoryListing( Listbox1 );
  1406.     TheFTPComponent.GetLocalDirectoryAndListing( TheReturnString ,
  1407.      Listbox2 );
  1408.     if Label5.Canvas.TextWidth( TheReturnString ) > Label5.Width then
  1409.      TheReturnString := TheFTPComponent.GetShortPathName( TheReturnString );
  1410.     Label5.Caption := TheReturnString;
  1411.     SetNormalCursors;
  1412.     Result := true;
  1413.     EnableFTPMenus;
  1414.     TheFTPComponent.FTPCommandInProgress := false;
  1415.     Panel1.Caption := '  Status : Connected to ' + PCRPointer^.CIPAddress;
  1416.   end;
  1417. end;
  1418.  
  1419. { This procedure actually attempts to disconnect to the internet at an ftp site}
  1420. procedure TCCINetCCForm.DoFTPDisconnect;
  1421. begin
  1422.   { Call QUIT command }
  1423.   TheFTPComponent.Disconnect;
  1424.   { Kill the socket }
  1425.   TheFTPComponent.Socket1.CCSockClose;
  1426. end;
  1427.  
  1428. { This procedure reads in the ini file and default path info }
  1429. procedure TCCINetCCForm.ReadIniData;
  1430. begin
  1431.   TheICCIniFile := TIniFile.Create( 'CCICC.INI' );
  1432.   MailPath := TheICCIniFile.ReadString( 'Paths','MailPath','C:\WINDOWS' );
  1433.   NewsPath := TheICCIniFile.ReadString( 'Paths','NewsPath','C:\WINDOWS' );
  1434.   WWWPath := TheICCIniFile.ReadString( 'Paths','WWWPath','C:\WINDOWS' );
  1435.   FTPPath := TheICCIniFile.ReadString( 'Paths','FTPPath','C:\WINDOWS' );
  1436.   PasswordControlVector := TheICCIniFile.ReadInteger( 'Vectors','PWControl',2 );
  1437.   DefaultDownloadVector := TheICCIniFile.ReadInteger( 'Vectors','DefDL', 3 );
  1438.   TheAnonRedialVector := TheICCIniFile.ReadInteger( 'Vectors','AnonRD', 20 );
  1439.   TheICCIniFile.Free;
  1440. end;
  1441.  
  1442. { This procedure writes out default path data to the ini file }
  1443. procedure TCCINetCCForm.WriteIniData;
  1444. begin
  1445.   TheICCIniFile := TIniFile.Create( 'CCICC.INI' );
  1446.   TheICCIniFile.WriteString( 'Paths','MailPath',MailPath );
  1447.   TheICCIniFile.WriteString( 'Paths','NewsPath',NewsPath );
  1448.   TheICCIniFile.WriteString( 'Paths','WWWPath',WWWPath );
  1449.   TheICCIniFile.WriteString( 'Paths','FTPPath',FTPPath );
  1450.   TheICCIniFile.WriteInteger( 'Vectors','PWControl',PasswordControlVector );
  1451.   TheICCIniFile.WriteInteger( 'Vectors','DefDL',DefaultDownloadVector );
  1452.   TheICCIniFile.WriteInteger( 'Vectors','AnonRD', TheAnonRedialVector );
  1453.   TheICCIniFile.Free;
  1454. end;
  1455.  
  1456. { Procedure to load the FTP Site list }
  1457. procedure TCCINetCCForm.LoadFTPSiteFile;
  1458. var TheTCRecord : PConnectionsRecord; { Generic TCR Pointer    }
  1459.     FTPSLName   : string;             { FTP Site List filename }
  1460.     Counter_1   : Integer;            { Loop counter           }
  1461. begin
  1462.   { Create the sites list list }
  1463.   TheFTPSiteList := TList.Create;
  1464.   { Set up the FTP sites list file name }
  1465.   FTPSLName := FTPPath + '\FTPSITES.TCR';
  1466.   { If the FTP Site List exists load it in }
  1467.   if FileExists( FTPSLName ) then
  1468.   begin
  1469.     { set up the file and open it }
  1470.     AssignFile( TheFTPSiteFile , FTPSLName );
  1471.     Reset( TheFTPSiteFile );
  1472.     { read in the records }
  1473.     for Counter_1 := 0 to FileSize( TheFTPSiteFile ) - 1 do
  1474.     begin
  1475.       { Create the TCRecord }
  1476.       New( TheTCRecord );
  1477.       { Read in the data record }
  1478.       Seek( TheFTPSiteFile , Counter_1 );
  1479.       Read( TheFTPSiteFile , TheTCRecord^ );
  1480.       { Add the record to the list }
  1481.       TheFTPSiteList.Add( TheTCRecord );
  1482.     end;
  1483.     { close the file }
  1484.     CloseFile( TheFTPSiteFile );
  1485.   end
  1486.   else
  1487.   { Otherwise create a default one with a few anonymous sites }
  1488.   begin
  1489.     { create new record }
  1490.     New( TheTCRecord );
  1491.     { fill in its info }
  1492.     with TheTCRecord^ do
  1493.     begin
  1494.       CProfile   := 'Winsite Windows Archive';
  1495.       CIPAddress := 'ftp.winsite.com';
  1496.       CUserName  := 'anonymous';
  1497.       CPassword  := 'guest@nowhere.com';
  1498.       CStartDir  := '';
  1499.     end;
  1500.     { add it to the list }
  1501.     { do it three more times }
  1502.     TheFTPSiteList.Add( TheTCRecord );
  1503.     New( TheTCRecord );
  1504.     with TheTCRecord^ do
  1505.     begin
  1506.       CProfile   := 'Digital Equipment Corp';
  1507.       CIPAddress := 'gatekeeper.dec.com';
  1508.       CUserName  := 'anonymous';
  1509.       CPassword  := 'guest@nowhere.com';
  1510.       CStartDir  := '';
  1511.     end;
  1512.     TheFTPSiteList.Add( TheTCRecord );
  1513.     New( TheTCRecord );
  1514.     with TheTCRecord^ do
  1515.     begin
  1516.       CProfile   := 'Microsoft FTP Site';
  1517.       CIPAddress := 'ftp.microsoft.com';
  1518.       CUserName  := 'anonymous';
  1519.       CPassword  := 'guest@nowhere.com';
  1520.       CStartDir  := '';
  1521.     end;
  1522.     TheFTPSiteList.Add( TheTCRecord );
  1523.     New( TheTCRecord );
  1524.     with TheTCRecord^ do
  1525.     begin
  1526.       CProfile   := 'Oakland MSDOS Archive';
  1527.       CIPAddress := 'oak.oakland.edu';
  1528.       CUserName  := 'anonymous';
  1529.       CPassword  := 'guest@nowhere.com';
  1530.       CStartDir  := '';
  1531.     end;
  1532.     TheFTPSiteList.Add( TheTCRecord );
  1533.     { create the file and write out the data, then close it }
  1534.     AssignFile( TheFTPSiteFile , FTPSLName );
  1535.     Rewrite( TheFTPSiteFile );
  1536.     for Counter_1 := 0 to 3 do
  1537.     begin
  1538.       TheTCRecord :=
  1539.        PConnectionsRecord( TheFTPSiteList.Items[ Counter_1 ] );
  1540.       Seek( TheFTPSiteFile , Counter_1 );
  1541.       Write( TheFTPSiteFile , TheTCRecord^ );
  1542.     end;
  1543.     CloseFile( TheFTPSiteFile );
  1544.   end;
  1545. end;
  1546.  
  1547. { This procedure saves off the FTP Site List }
  1548. procedure TCCINetCCForm.SaveFTPSiteFile;
  1549. var TheTCRecord : PConnectionsRecord; { The TC Record pointer  }
  1550.     FTPSLName   : string;             { FTP Site List filename }
  1551.     Counter_1   : Integer;            { Loop counter           }
  1552. begin
  1553.   { Set up the file name }
  1554.   FTPSLName := FTPPath + '\FTPSITES.TCR';
  1555.   { Assign the file }
  1556.   AssignFile( TheFTPSiteFile , FTPSLName );
  1557.   { Rewrite it }
  1558.   Rewrite( TheFTPSiteFile );
  1559.   { run the list through the procedure }
  1560.   for Counter_1 := 0 to TheFTPSiteList.Count - 1 do
  1561.   begin
  1562.     { get the record from the list }
  1563.     TheTCRecord :=
  1564.      PConnectionsRecord( TheFTPSiteList.Items[ Counter_1 ] );
  1565.     { Do the seek/write }
  1566.     Seek( TheFTPSiteFile , Counter_1 );
  1567.     Write( TheFTPSiteFile , TheTCRecord^ );
  1568.     { free the record }
  1569.     Dispose( TheTCRecord );
  1570.   end;
  1571.   { Close the file }
  1572.   CloseFile( TheFTPSiteFile );
  1573.   { Free the list pointers }
  1574.   TheFTPSiteList.Free;
  1575.   TheWorkingFTPSL.Free;
  1576. end;
  1577.  
  1578. { This procedure switches in the FTP sites list to the info dlg and main cbox }
  1579. procedure TCCINetCCForm.SetupFTPSiteLists;
  1580. var ThePointer : PConnectionsRecord; { Generic PCR Pointer }
  1581.     Counter_1  : Integer;            { Loop counter        } 
  1582. begin
  1583.   { Set up display for main form }
  1584.   CCINetCCForm.Tag := 2;
  1585.   CCINetCCForm.Caption := 'CC Internet Command Center -- FTP Mode';
  1586.   CCINetCCForm.ViewWinsockInfo1.Enabled := false;
  1587.   CCINetCCForm.FTP1.Enabled := false;
  1588.   CCINetCCForm.FTP2.Enabled := true;
  1589.   CCINetCCForm.Label1.Caption := 'FTP Site:';
  1590.   CCINetCCForm.Button1.Caption := 'Connect';
  1591.   CCINetCCForm.Label4.Caption := 'Local Dir';
  1592.   CCINetCCForm.Label5.Caption := 'Remote Dir';
  1593.   { Set tag for FTP stuff }
  1594.   CCICInfoDlg.Tag := 2;
  1595.   { set up caption of main label }
  1596.   CCICInfoDlg.Label2.Caption := 'FTP Sites';
  1597.   { hide outline panel }
  1598.   CCICInfoDlg.Panel6.Visible := false;
  1599.   { clear the list box }
  1600.   CCICInfoDlg.ListBox2.Clear;
  1601.   CCINetCCForm.ComboBox1.Clear;
  1602.   { add profile strings to the list box }
  1603.   for Counter_1 := 0 to TheFTPSiteList.Count - 1 do
  1604.   begin
  1605.     CCICInfoDlg.ListBox2.Items.Add( PConnectionsRecord(
  1606.      TheFTPSiteList.Items[ Counter_1 ] )^.CProfile );
  1607.     CCINetCCForm.ComboBox1.Items.Add( PConnectionsRecord(
  1608.      TheFTPSiteList.Items[ Counter_1 ] )^.CProfile );
  1609.   end;
  1610.   { Set up caption of special button }
  1611.   CCICInfoDlg.Button1.Caption := 'Anonymous Login';
  1612.   { Start with top record }
  1613.   CCICInfoDlg.ListBox2.ItemIndex := 0;
  1614.   CCINetCCForm.ComboBox1.ItemIndex := 0;
  1615.   { put in data from top record and reset captions }
  1616.   with PConnectionsRecord( TheFTPSiteList.Items[ 0 ] )^ do
  1617.   begin
  1618.     with CCICInfoDlg do
  1619.     begin
  1620.       Edit1.Text := CProfile;
  1621.       Panel2.Caption := '            Name:';
  1622.       Edit2.Text := CIPAddress;
  1623.       Panel3.Caption := '     IP Address:';
  1624.       Edit3.Text := CUserName;
  1625.       Panel5.Caption := '    User Name:';
  1626.       case PasswordControlVector of
  1627.         1 : Edit4.Text := CPassword;
  1628.         2 : Edit4.Text := '**********';
  1629.       end;
  1630.       Panel8.Caption := '      Password:';
  1631.       Edit5.Text := CStartDir;
  1632.       Panel9.Caption := '    Starting Dir:';
  1633.     end;
  1634.   end;
  1635.   { Create the working copy for use to make safe changes in info dlg }
  1636.   TheWorkingFTPSL := TList.Create;
  1637.   For Counter_1 := 0 to TheFTPSiteList.Count - 1 do
  1638.   begin
  1639.     New( ThePointer );
  1640.     ThePointer^ := PConnectionsRecord( TheFTPSiteList.Items[ Counter_1 ] )^;
  1641.     TheWorkingFTPSL.Add( ThePointer );
  1642.   end;
  1643. end;
  1644.  
  1645. { This procedure scans a line of UNIX-style text for #10's and }
  1646. { outputs them as lines to the memo. It stops at #0.           }
  1647. procedure TCCINetCCForm.AddNullTermTextToMemo( TheTextToAdd   : string;
  1648.                                  TheMemoToAddTo : TMemo   );
  1649. var
  1650.   TextLength ,            { Total chars to output         }
  1651.   Counter_1    : Integer; { Loop Index                    }
  1652. begin
  1653.   { Make the target memo visible just in case }
  1654.   TheMemoToAddTo.Visible := true;
  1655.   { Find total chars to output }
  1656.   TextLength := Length( TheTextToAdd );
  1657.   { If none then leave }
  1658.   if TextLength = 0 then exit;
  1659.   { Loop along the string }
  1660.   for Counter_1 := 1 to TextLength do
  1661.   begin
  1662.     { If hit ASCII 10 then assume end of line and output }
  1663.     if TheTextToAdd[ Counter_1 ] = #10 then
  1664.     begin
  1665.       { Use a try loop incase memo fills up }
  1666.       try
  1667.         { Add the line }
  1668.         TheMemoToAddTo.Lines.Add( TheLine );
  1669.       except
  1670.         { If memo fills up }
  1671.         on EOutOfResources do
  1672.         begin
  1673.           { Clear the old data }
  1674.           TheMemoToAddTo.Clear;
  1675.           { Output the new }
  1676.           TheMemoToAddTo.Lines.Add( TheLine );
  1677.         end;
  1678.       end;
  1679.       { clear the output buffer }
  1680.       TheLine := '';
  1681.     end
  1682.     else
  1683.     { Otherwise look for null terminator from Winsock }
  1684.     begin
  1685.       { If don't hit null terminator then add the char to op buffer }
  1686.       if TheTextToAdd[ Counter_1 ] <> #0 then
  1687.       begin
  1688.         TheLine := TheLine + TheTextToAdd[ Counter_1 ];
  1689.       end
  1690.       else
  1691.       begin
  1692.         if TheLine <> '' then
  1693.         begin
  1694.           { Use a try loop incase memo fills up }
  1695.           try
  1696.             { Add the line }
  1697.             TheMemoToAddTo.Lines.Add( TheLine );
  1698.           except
  1699.             { If memo fills up }
  1700.             on EOutOfResources do
  1701.             begin
  1702.               { Clear the old data }
  1703.               TheMemoToAddTo.Clear;
  1704.               { Output the new }
  1705.               TheMemoToAddTo.Lines.Add( TheLine );
  1706.             end;
  1707.           end;
  1708.           { clear the output buffer }
  1709.           TheLine := '';
  1710.         end;
  1711.       end;
  1712.     end;
  1713.   end;
  1714. end;
  1715.  
  1716. { This function scans a line of UNIX-style text for #10's and }
  1717. { outputs the first line as its return value,stopping at #0.  }
  1718. function TCCINetCCForm.AddNullTermTextToLabel( TheTextToAdd   : string ) : string;
  1719. var
  1720.   TheLine      : string;  { Buffer to output current line }
  1721.   TextLength ,            { Total chars to output         }
  1722.   Counter_1    : Integer; { Loop Index                    }
  1723. begin
  1724.   { Clear output buffer }
  1725.   TheLine := '';
  1726.   { Find total chars to output }
  1727.   TextLength := Length( TheTextToAdd );
  1728.   { If none then leave }
  1729.   if TextLength = 0 then
  1730.   begin
  1731.     { Return nothing }
  1732.     Result := '';
  1733.     { Leave }
  1734.     exit;
  1735.   end;
  1736.   { Loop along the string }
  1737.   for Counter_1 := 1 to TextLength do
  1738.   begin
  1739.     { If hit ASCII 10 then assume end of line and output }
  1740.     if TheTextToAdd[ Counter_1 ] = #10 then
  1741.     begin
  1742.       { Return first line }
  1743.       Result := TheLine;
  1744.       { Leave }
  1745.       exit;
  1746.     end
  1747.     else
  1748.     { Otherwise look for null terminator from Winsock }
  1749.     begin
  1750.       { If don't hit null terminator then add the char to op buffer }
  1751.       if TheTextToAdd[ Counter_1 ] <> #0 then
  1752.       begin
  1753.         TheLine := TheLine + TheTextToAdd[ Counter_1 ];
  1754.       end
  1755.       else break; { Otherwise drop out of the loop }
  1756.     end;
  1757.   end;
  1758.   { If hit #0 before #10 return buffer }
  1759.   Result := TheLine;
  1760. end;
  1761.  
  1762. { Show busy cursors }
  1763. procedure TCCINetCCForm.SetHGCursors;
  1764. begin
  1765.   CCInetCCForm.Cursor := crHourGlass;
  1766.   CCInetCCForm.Memo1.Cursor := crHourGlass;
  1767. end;
  1768.  
  1769. { Show normal cursors }
  1770. procedure TCCINetCCForm.SetNormalCursors;
  1771. begin
  1772.   CCInetCCForm.Cursor := crDefault;
  1773.   CCInetCCForm.Memo1.Cursor := crDefault;
  1774. end;
  1775.  
  1776. { Exit method }
  1777. procedure TCCINetCCForm.Exit1Click(Sender: TObject);
  1778. begin
  1779.   Close;
  1780. end;
  1781.  
  1782. { This method adds a line to the progress text stringlist  }
  1783. { If an exception occurs, the list is full, and it is auto }
  1784. { saved to the progress text file name, then cleared.      }
  1785. procedure TCCINetCCForm.AddProgressText( WhatText : string );
  1786. begin
  1787.   { Use a try..except loop to catch list overflows }
  1788.   try
  1789.     { Try the normal add }
  1790.     ProgressList.Add( WhatText );
  1791.   except
  1792.     { Any list error is assumed to be a list overflow }
  1793.     on EListError do
  1794.     begin
  1795.       { Save the list to the preset file name }
  1796.       ProgressList.SaveToFile( ProgressFileName );
  1797.       { Clear the list to make more room }
  1798.       ProgressList.Clear;
  1799.       { And redo the add; any further errors will except normally }
  1800.       ProgressList.Add( WhatText );
  1801.     end;
  1802.     { This might happen too! }
  1803.     on EOutOfResources do
  1804.     begin
  1805.       { Save the list to the preset file name }
  1806.       ProgressList.SaveToFile( ProgressFileName );
  1807.       { Clear the list to make more room }
  1808.       ProgressList.Clear;
  1809.       { And redo the add; any further errors will except normally }
  1810.       ProgressList.Add( WhatText );
  1811.     end;
  1812.   end;
  1813. end;
  1814.  
  1815. { This method either adds the progress line to the current memo }
  1816. { or puts it in the status caption at normal colors.            }
  1817. procedure TCCINetCCForm.ShowProgressText( WhatText : string );
  1818. begin
  1819.   { Use the POV to determine where to show progress info }
  1820.   case ProgressOutputVector of
  1821.     POV_MEMO : begin { Output into the memo  }
  1822.                  AddNullTermTextToMemo( WhatText , Memo1 );
  1823.                end;
  1824.     POV_STAT : begin { Output on status line }
  1825.                  { Set panel caption font to black }
  1826.                  Panel1.Font.Color := clBlack;
  1827.                  { Get the first line of text and put in caption }
  1828.                  Panel1.Caption := AddNullTermTextToLabel( WhatText );
  1829.                end;
  1830.   end;
  1831. end;
  1832.  
  1833. { This method is identical with SPT except sets status color to red and beeps }
  1834. procedure TCCINetCCForm.ShowProgressErrorText( WhatText : string );
  1835. begin
  1836.   { Do error beep }
  1837.   MessageBeep( mb_IconExclamation );
  1838.   { Use the POV to determine where to show progress info }
  1839.   case ProgressOutputVector of
  1840.     POV_MEMO : begin { Output into the memo  }
  1841.                  AddNullTermTextToMemo( WhatText , Memo1 );
  1842.                end;
  1843.     POV_STAT : begin { Output on status line }
  1844.                  { Set panel caption font to black }
  1845.                  Panel1.Font.Color := clRed;
  1846.                  { Get the first line of text and put in caption }
  1847.                  Panel1.Caption := AddNullTermTextToLabel( WhatText );
  1848.                end;
  1849.   end;
  1850. end;
  1851.  
  1852. { This is the boilerplate method used to handle Socket errors gracefully }
  1853. procedure TCCINetCCForm.SocketsErrorOccurred( Sender     : TObject;
  1854.                                               ErrorCode  : Integer;
  1855.                                               TheMessage : string   );
  1856. begin
  1857.   { Set the global error code flag }
  1858.   GlobalErrorCode := ErrorCode;
  1859.   { If a timeout error }
  1860.   if ErrorCode = WSAETIMEDOUT then
  1861.   begin
  1862.     { Set the aborted flag }
  1863.     GlobalAbortedFlag := True;
  1864.     { But clear the error code for graceful handling }
  1865.     GlobalErrorCode := 0;
  1866.   end
  1867.   else
  1868.   begin
  1869.     { Otherwise set the progress buffer to the error message }
  1870.     AddProgressText( TheMessage );
  1871.     { And show the progress text as set by option }
  1872.     ShowProgressErrorText( TheMessage );
  1873.   end;
  1874. end;
  1875.  
  1876. procedure TCCINetCCForm.FormCreate(Sender: TObject);
  1877. begin
  1878.   { Create the progress string list }
  1879.   ProgressList := TStringList.Create;
  1880.   { Create the file name for saving the progress list }
  1881.   ProgressFileName := ExpandFileName( 'PROGRESS.TXT' );
  1882.   { Default progress output to status line }
  1883.   ProgressOutputVector := POV_STAT;
  1884.   { Set password control stuff }
  1885.   PasswordControlVector := 2;
  1886.   CurrentPasswordString := 'guest@nowhere.com';
  1887.   CurrentRealPWString := 'guest@nowhere.com';
  1888.   { Get Ini file Data }
  1889.   ReadIniData;
  1890.   LoadFTPSiteFile;
  1891. end;
  1892.  
  1893. procedure TCCINetCCForm.FormDestroy(Sender: TObject);
  1894. begin
  1895.   { Free the progress text stringlist if assigned }
  1896.   if assigned( ProgressList ) then ProgressList.Free;
  1897.   { Save off the Ini data }
  1898.   WriteIniData;
  1899.   { Save and remove FTP site list stuff }
  1900.   SaveFTPSiteFile;
  1901.   if Assigned( TheFTPComponent ) then TheFTPComponent.Free;
  1902. end;
  1903.  
  1904. procedure TCCINetCCForm.Description1Click(Sender: TObject);
  1905. var
  1906.   TempSocket : TCCSocket; { Temporary socket just to get Winsock info }
  1907.   TheData    : string;    { Holder for data                           }
  1908. begin
  1909.   { Create socket; auto calls WSAStartup }
  1910.   TempSocket := TCCSocket.Create( Self );
  1911.   { Do parent just for kicks; no longer needed }
  1912.   TempSocket.Parent := self;
  1913.   { Put in error handler }
  1914.   TempSocket.OnErrorOccurred := SocketsErrorOccurred;
  1915.   TheData := StrPas( TempSocket.Socket_WSA_Data.Description_String );
  1916.   { Display the Description string }
  1917.   AddProgressText( TheData + #0 );
  1918.   { And show the progress text as set by option }
  1919.   ShowProgressText( TheData + #0 );
  1920.   { Free the socket; auto calls WSACleanup }
  1921.   TempSocket.Free;
  1922. end;
  1923.  
  1924. procedure TCCINetCCForm.SystemStatus1Click(Sender: TObject);
  1925. var
  1926.   TempSocket : TCCSocket; { Temporary socket just to get Winsock info }
  1927.   TheData    : string;    { Holder for data                           }
  1928. begin
  1929.   { Create socket; auto calls WSAStartup }
  1930.   TempSocket := TCCSocket.Create( Self );
  1931.   { Do parent just for kicks; no longer needed }
  1932.   TempSocket.Parent := self;
  1933.   { Put in error handler }
  1934.   TempSocket.OnErrorOccurred := SocketsErrorOccurred;
  1935.   TheData := StrPas( TempSocket.Socket_WSA_Data.System_Status_String );
  1936.   { Display the Description string }
  1937.   AddProgressText( TheData + #0 );
  1938.   { And show the progress text as set by option }
  1939.   ShowProgressText( TheData + #0 );
  1940.   { Free the socket; auto calls WSACleanup }
  1941.   TempSocket.Free;
  1942. end;
  1943.  
  1944. procedure TCCINetCCForm.VendorSpecific1Click(Sender: TObject);
  1945. var
  1946.   TempSocket : TCCSocket; { Temporary socket just to get Winsock info }
  1947.   TheData    : string;    { Holder for data                           }
  1948. begin
  1949.   { Create socket; auto calls WSAStartup }
  1950.   TempSocket := TCCSocket.Create( Self );
  1951.   { Do parent just for kicks; no longer needed }
  1952.   TempSocket.Parent := self;
  1953.   { Put in error handler }
  1954.   TempSocket.OnErrorOccurred := SocketsErrorOccurred;
  1955.   TheData := StrPas( TempSocket.Socket_WSA_Data.Vendor_Specific_String );
  1956.   { Display the Description string }
  1957.   AddProgressText( TheData + #0 );
  1958.   { And show the progress text as set by option }
  1959.   ShowProgressText( TheData + #0 );
  1960.   { Free the socket; auto calls WSACleanup }
  1961.   TempSocket.Free;
  1962. end;
  1963.  
  1964. { This method sets the progress output vector to the memo }
  1965. procedure TCCINetCCForm.ViewInEditWindow1Click(Sender: TObject);
  1966. begin
  1967.   { Set the vector }
  1968.   ProgressOutputVector := POV_MEMO;
  1969.   { Keep the menu options consistent }
  1970.   ViewInEditWindow1.Checked := true;
  1971.   ViewInStatusLine1.Checked := false;
  1972. end;
  1973.  
  1974. { This method sets the progress output vector to the status line }
  1975. procedure TCCINetCCForm.ViewInStatusLine1Click(Sender: TObject);
  1976. begin
  1977.   { Set the vector }
  1978.   ProgressOutputVector := POV_STAT;
  1979.   { Keep the menus consistent }
  1980.   ViewInEditWindow1.Checked := false;
  1981.   ViewInStatusLine1.Checked := true;
  1982. end;
  1983.  
  1984. procedure TCCINetCCForm.SaveToFile1Click(Sender: TObject);
  1985. begin
  1986.   { Set up the dialog parameters }
  1987.   OpenDialog1.Filename := ProgressFileName;
  1988.   OpenDialog1.Title := 'Select Filename for Progress File';
  1989.   OpenDialog1.Filter := 'Text Files|*.txt';
  1990.   { If the dialog is not cancelled then save and clear }
  1991.   if OpenDialog1.Execute then
  1992.   begin
  1993.     ProgressFileName := OpenDialog1.FileName;
  1994.     ProgressList.SaveToFile( ProgressFileName );
  1995.     ProgressList.Clear;
  1996.   end;
  1997. end;
  1998.  
  1999. procedure TCCINetCCForm.IPAddress1Click(Sender: TObject);
  2000. begin
  2001.   { Set up info dialog for IP Address getting }
  2002.   CCICInfoDlg.Caption := 'CC Internet Center -- Translate IP Address';
  2003.   CCICInfoDlg.Panel4.Visible := false;
  2004.   CCICInfoDlg.Panel6.Visible := false;
  2005.   CCICInfoDlg.Panel9.Visible := false;
  2006.   CCICInfoDlg.Panel8.Visible := false;
  2007.   CCICInfoDlg.BitBtn2.Visible := false;
  2008.   CCICInfoDlg.Button1.Caption := 'Get IP Address';
  2009.   CCICInfoDlg.Button2.Visible := false;
  2010.   CCICInfoDlg.Button3.Visible := false;
  2011.   CCICInfoDlg.Button4.Visible := false;
  2012.   CCICInfoDlg.Panel2.Caption := 'IP Addr Name:';
  2013.   CCICInfoDlg.Panel3.Caption := '    Dotted Dec:';
  2014.   CCICInfoDlg.Panel5.Caption := '           Binary:';
  2015.   CCICInfoDlg.Edit1.Text := '';
  2016.   CCICInfoDlg.Edit2.Text := '';
  2017.   CCICInfoDlg.Edit3.Text := '';
  2018.   { Set IP Address Mode }
  2019.   CCICInfoDlg.Tag := 1;
  2020.   { Show Modally to get the information }
  2021.   CCICInfoDlg.ShowModal;
  2022.   { Reset the info dialog to default conditions }
  2023.   CCICInfoDlg.Caption := 'CC Internet Command Center Information Dialog';
  2024.   CCICInfoDlg.Panel4.Visible := true;
  2025.   CCICInfoDlg.Panel6.Visible := true;
  2026.   CCICInfoDlg.Panel9.Visible := true;
  2027.   CCICInfoDlg.Panel8.Visible := true;
  2028.   CCICInfoDlg.BitBtn2.Visible := true;
  2029.   CCICInfoDlg.Button1.Caption := 'Anonymous Login';
  2030.   CCICInfoDlg.Button2.Visible := true;
  2031.   CCICInfoDlg.Button3.Visible := true;
  2032.   CCICInfoDlg.Button4.Visible := true;
  2033.   CCICInfoDlg.Panel2.Caption := '             Name:';
  2034.   CCICInfoDlg.Panel3.Caption := '    IP Address:';
  2035.   CCICInfoDlg.Panel5.Caption := ' User Name:';
  2036.   CCICInfoDlg.Edit1.Text := '';
  2037.   CCICInfoDlg.Edit2.Text := '';
  2038.   CCICInfoDlg.Edit3.Text := '';
  2039. end;
  2040.  
  2041. procedure TCCINetCCForm.FTP1Click(Sender: TObject);
  2042. begin
  2043.   { Set up the FTP Data displays }
  2044.   SetupFTPSiteLists;
  2045.   TheFTPComponent := TFTPComponent.Create( CCInetCCForm );
  2046.   TheFTPComponent.Parent := CCInetCCForm;
  2047. end;
  2048.  
  2049. procedure TCCINetCCForm.FormResize(Sender: TObject);
  2050. begin
  2051.   { Use tag vector to determine what to do }
  2052.   case Tag of
  2053.     { if FTP , make sure two list boxes are same height }
  2054.     2 : Panel6.Height := (( Panel4.Height div 2 ) - 30 );
  2055.   end;
  2056. end;
  2057.  
  2058. procedure TCCINetCCForm.FTPSites1Click(Sender: TObject);
  2059. begin
  2060.   { Show Modally to get the information }
  2061.   CCICInfoDlg.ShowModal;
  2062. end;
  2063.  
  2064. procedure TCCINetCCForm.FTP3Click(Sender: TObject);
  2065. begin
  2066.   CCICPrefsDlg.TabbedNoteBook1.PageIndex := 1;
  2067.   CCICPrefsDlg.Tag := 2;
  2068.   CCICPrefsDlg.ShowModal;
  2069. end;
  2070.  
  2071. procedure TCCINetCCForm.ConnectToSite1Click(Sender: TObject);
  2072. var Counter_1 : Integer;
  2073. begin
  2074.   if Lowercase( PConnectionsRecord( TheFTPSiteList.Items[
  2075.    ComboBox1.ItemIndex ] )^.CUserName ) = 'anonymous' then
  2076.   begin
  2077.     for Counter_1 := 1 to TheAnonRedialVector do
  2078.     begin
  2079.       DoFTPConnection( PConnectionsRecord(
  2080.          TheFTPSiteList.Items[ ComboBox1.ItemIndex ] ));
  2081.       if TheFTPComponent.Connection_Established then exit;
  2082.     end;
  2083.   end
  2084.   else DoFTPConnection( PConnectionsRecord(
  2085.    TheFTPSiteList.Items[ ComboBox1.ItemIndex ] ));
  2086. end;
  2087.  
  2088. procedure TCCINetCCForm.Button1Click(Sender: TObject);
  2089. begin
  2090.   case Tag of
  2091.     2 : begin
  2092.           if not TheFTPComponent.Connection_Established then
  2093.            ConnectToSite1Click( Self ) else
  2094.            begin
  2095.              DoFTPDisconnect;
  2096.              TheFTPComponent.Connection_Established := false;
  2097.              DisableFTPMenus;
  2098.            end;
  2099.         end;
  2100.   end;
  2101. end;
  2102.  
  2103. procedure TCCINetCCForm.ViewasText1Click(Sender: TObject);
  2104. begin
  2105.   { Assume valid FTP component and have it send its text into the progress text}
  2106.   TheFTPComponent.GetRemoteDirectoryListingToMemo;
  2107. end;
  2108.  
  2109. procedure TCCINetCCForm.Disconnect1Click(Sender: TObject);
  2110. begin
  2111.   DoFTPDisconnect;
  2112.   DisableFTPMenus;
  2113. end;
  2114.  
  2115. procedure TCCINetCCForm.EnableFTPMenus;
  2116. begin
  2117.   Button1.Caption := 'Disconnect';
  2118.   ConnectToSite1.Enabled := false;
  2119.   Disconnect1.Enabled := true;
  2120.   Directory1.Enabled := true;
  2121.   UploadMarked1.Enabled := true;
  2122.   DownloadMarked1.Enabled := true;
  2123. end;
  2124.  
  2125. procedure TCCINetCCForm.DisableFTPMenus;
  2126. begin
  2127.   Button1.Caption := 'Connect';
  2128.   ConnectToSite1.Enabled := true;
  2129.   Disconnect1.Enabled := false;
  2130.   Directory1.Enabled := false;
  2131.   UploadMarked1.Enabled := false;
  2132.   DownloadMarked1.Enabled := false;
  2133. end;
  2134.  
  2135. procedure TCCINetCCForm.Change1Click(Sender: TObject);
  2136. var TheDir : string;
  2137. begin
  2138.   if ListBox1.ItemIndex = -1 then exit;
  2139.   TheDir := ListBox1.Items[ ListBox1.ItemIndex ];
  2140.   if TheFTPComponent.SetRemoteDirectory( TheDir ) then
  2141.   begin
  2142.     TheFTPComponent.GetRemoteWorkingDirectory( TheDir ); 
  2143.     { Put up remote directory via PWD and strip quotes }
  2144.     Label4.Caption := TheFTPComponent.GetQuotedString( TheDir );
  2145.     { Get the listings of directories and exit OK }
  2146.     TheFTPComponent.GetRemoteDirectoryListing( Listbox1 );
  2147.   end;
  2148. end;
  2149.  
  2150. procedure TCCINetCCForm.ChangeLocal1Click(Sender: TObject);
  2151. var TheDir : string;
  2152. begin
  2153.   if ListBox2.ItemIndex = -1 then exit;
  2154.   TheDir := ListBox2.Items[ ListBox2.ItemIndex ];
  2155.   TheDir := TheFTPComponent.StripBrackets( TheDir );
  2156.   if TheDir = '..' then
  2157.   begin
  2158.     ChDir( TheDir );
  2159.   end
  2160.   else
  2161.   begin
  2162.     TheDir := ExpandFileName( TheDir );
  2163.     ChDir( TheDir );
  2164.   end;
  2165.   TheFTPComponent.GetLocalDirectoryAndListing( TheDir , Listbox2 );
  2166.   if Label5.Canvas.TextWidth( TheDir ) > Label5.Width then
  2167.    TheDir := TheFTPComponent.GetShortPathName( TheDir );
  2168.   Label5.Caption := TheDir;
  2169. end;
  2170.  
  2171. procedure TCCINetCCForm.ListBox1DblClick(Sender: TObject);
  2172. begin
  2173.   case Tag of
  2174.     2 : begin
  2175.           case DefaultDownLoadVector of
  2176.             3 : Change1Click( Self );
  2177.           end;
  2178.         end;
  2179.   end;
  2180. end;
  2181.  
  2182. procedure TCCINetCCForm.ListBox2DblClick(Sender: TObject);
  2183. begin
  2184.   case Tag of
  2185.     2 : begin
  2186.           case DefaultDownLoadVector of
  2187.             3 : ChangeLocal1Click( Self );
  2188.           end;
  2189.         end;
  2190.   end;
  2191. end;
  2192.  
  2193. end.
  2194.